home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / demo / LoadMe next >
Text File  |  1995-04-05  |  5KB  |  110 lines

  1.  3 pause
  2.    page
  3.    begin
  4.      0 color 12 cv  26 ch  ." Random stars, press any key"
  5.      24 random cv  80 random ch  8 random color  42 emit
  6.    key? until  key drop
  7. ;
  8.  
  9. variable n
  10. : demo2 ( -- ) ( graphics demo )
  11.    page 0 color
  12.    ." MacQForth adds simple line graphics using !PEN and -TO:"
  13.    cr cr ." ' 5 50 !pen   450 50 -to '"
  14.    1 color 5 50 !pen  450 50 -to 0 color
  15.    8 cv 1 ch
  16.    ." Or, use PLOT to plot a point and COLOR to select a color:" cr
  17.    10 n !
  18.    8 0 do  i color
  19.      30 n @ +  n @ do
  20.        i 117 !pen  i 147 -to
  21.      loop
  22.      60 n +!
  23.    loop  0 color
  24.    14 cv
  25.    ."  black     red      green      blue      cyan     magenta"
  26.    ."    yellow   white"
  27.    22 cv 1 ch ." <press a key>"  begin  key? until key drop
  28. ;
  29.  
  30. create fn  string LoadMe.txt~ 10 allot 0 c,  ( filename )
  31. create bf  512 allot  ( data buffer )
  32. : demo3 ( -- ) ( file demo )
  33.    page  0 color
  34.    ." MacQForth offers access to Mac TEXT files via the words:" cr cr
  35.    1 color
  36.    ." fcreate  fdestroy  fopen  fposition  fread  fwrite  fclose" cr
  37.    0 color cr
  38.    cr ." For example, the file 'LoadMe.txt' will be displayed below"
  39.    cr ." ----------------------------------------------------------" cr cr
  40.    5 color
  41.    0 fn fopen
  42.    0= if
  43.      0 bf 512 fread drop
  44.      ( #bytes ) 0 do  i bf + c@ emit  loop
  45.      0 fclose drop
  46.    else
  47.      ." Error file not found or is busy." cr
  48.    then
  49.    0 color
  50.    22 cv 1 ch ." <press a key>"  begin key? until key drop
  51. ;
  52.  
  53. : demo4 ( -- ) ( misc demo )
  54.    page  2 color
  55.    ." Miscellaneous features"
  56.    cr cr cr 0 color
  57.    ." MacQForth has complete mouse control, move the mouse, press the"
  58.    ."  button to exit."
  59.    4 color begin  
  60.      ?mouse  
  61.      7 cv 32 ch swap . space .  
  62.    ?button until
  63.    0 color 9 cv 1 ch
  64.    ." MacQForth also has additions for random numbers and to provide a" cr
  65.    ." disassembled listing of the code for any word.  Press a key to see" cr
  66.    ." the code for the word SIERP which plots one triangle point:" cr cr
  67.    key drop  1 color ' sierp de  key drop
  68. ;
  69.  
  70.                                                                ( demo table )
  71.  
  72. create table  ( table of demos )
  73.   ' demo1 ,  ' demo2 ,  ' demo3 ,  ' demo4 ,
  74.  
  75. : doDemo  ( n -- ) ( execute a demo )
  76.    1- 2* table + @ execute ;
  77.  
  78.                                                                      ( menu )
  79.  
  80. : menu ( -- n ) ( get a menu choice )
  81.    page  boxSierp  2 color
  82.    40 ch ." Demonstration menu" cr cr 
  83.    3 color
  84.    40 ch ."  1... Text demo" cr
  85.    40 ch ."  2... Graphics demo" cr
  86.    40 ch ."  3... File demo" cr
  87.    40 ch ."  4... Misc demo" cr cr
  88.    40 ch ."  5... Quit" cr cr 
  89.    5 color  40 ch ." Which ? "
  90.    begin
  91.      begin
  92.        sierp  ( plot a point in the triangle )
  93.      key? until
  94.      key 48 - dup dup
  95.      0 > swap 6 < and
  96.      if  -1  else  drop 0  then
  97.    until
  98. ;
  99.  
  100.                                                                   ( startup )
  101.  
  102. : startup
  103.    title
  104.    begin
  105.      menu
  106.      dup 5 <> if dup doDemo else then
  107.    5 = until cr 0 color
  108.    forget task
  109. ;
  110.